home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / dev / lang / ace102.lha / include / font.h < prev    next >
Text File  |  1993-04-11  |  1KB  |  50 lines
  1. { change font for the current window/screen. }
  2.          
  3. SUB FontSet(FontName$,FontHeight%)
  4. dim tAttr&(2)
  5.  
  6. DECLARE FUNCTION OpenDiskFont& LIBRARY diskfont
  7. DECLARE FUNCTION CloseFont LIBRARY graphics
  8. DECLARE FUNCTION OpenFont& LIBRARY graphics
  9. DECLARE FUNCTION SetFont LIBRARY graphics
  10.  
  11. CONST Font=52
  12. CONST TxWidth=60
  13.  
  14. LIBRARY diskfont
  15. LIBRARY graphics
  16.  
  17.   f.old&     = *&(WINDOW(8)+Font)
  18.   f.pref%    = 0
  19.   FontName0$ = FontName$ + ".font"
  20.   tAttr&(0)  = SADD(FontName0$)
  21.   tAttr&(1)  = FontHeight%*2^16 + f.pref%
  22.   f.new&     = OpenFont&(@tAttr&)  '..ROM font?
  23.   f.check%   = *%(WINDOW(8)+TxWidth)
  24.   
  25.   '..disk font -> open it
  26.   IF f.new& = 0& THEN
  27.     f.new& = OpenDiskFont&(@tAttr&)
  28.   ELSE
  29.    IF f.check% <> FontHeight% THEN
  30.     CloseFont(f.new&)
  31.     f.new& = OpenDiskFont&(@tAttr&)
  32.    END IF
  33.   END IF
  34.   
  35.   '..font OK -> set it for current rastport.
  36.   IF f.new& <> 0& THEN
  37.     CloseFont(f.old&)
  38.     SetFont(WINDOW(8),f.new&)
  39.   ELSE
  40.     IF UCASE$(FontName$) = "UNDO" THEN
  41.       CloseFont(f.old&)
  42.       SetFont(WINDOW(8),original&)
  43.     END IF
  44.   END IF
  45.  
  46.   LIBRARY CLOSE graphics
  47.   LIBRARY CLOSE diskfont
  48.  
  49. END SUB
  50.